home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_bas / vbtrc96.zip / VBTRC96.BAS < prev    next >
BASIC Source File  |  1996-04-07  |  8KB  |  219 lines
  1.    Option Explicit
  2.    DefInt A-Z
  3.                
  4. '--TIMER FUNCTION
  5.    Declare Function CMS_TimeGetTime Lib "MMSystem" Alias "TimeGetTime" () As Long
  6.  
  7. '--INI FILES
  8.    Declare Function CMS_GetPrivateProfileString Lib "Kernel" Alias "GetPrivateProfileString" (ByVal Appname As String, ByVal KeyName As String, ByVal DEFAULT As String, ByVal ReturnedString As String, ByVal MaxSize, ByVal Filename As String)
  9.  
  10. '--GET FREE GDI AND USR MEMORY
  11.    Declare Function CMS_GetFreeSystemResources Lib "User" Alias "GetFreeSystemResources" (ByVal fuSysResource)
  12.    Global Const CMS_GDI = 1
  13.    Global Const CMS_USR = 2
  14.  
  15. '--GET SYSTEM MEMORY
  16.    Declare Function CMS_GetFreeSpace Lib "Kernel" Alias "GetFreeSpace" (ByVal wFlags) As Long
  17.  
  18. '--FREE DISK SPACE
  19.    Declare Function CMS_DiskSpaceFree Lib "SetupKit.DLL" Alias "DiskSpaceFree" () As Long
  20.  
  21. Sub VBProcedureTrace (OpCode, ProcedureName As String)
  22.  
  23. '--DECLARE VARIABLES
  24.    Dim I, J
  25.    Dim Result
  26.    Dim FL As Long
  27.    Dim SyncCode As String
  28.    Dim ThisTime As Long
  29.    Dim OutRecord As String
  30.    Dim TraceGridVariable As String
  31.    Dim ElapsedTime As String
  32.    Dim CumlativeTime As String
  33.    Dim TotalTime As String
  34.    Dim Percent As String
  35.    Dim Msg As String
  36.    Dim ppFileName As String
  37.    Dim ppValue As String
  38.  
  39. '--DECLARE CONSTANTS
  40.    Const IconStop = 16
  41.    Const ThisProgramsSyncCode = ""
  42.    Const TraceFileRecordLength = 600
  43.    Const ppTitle = "VBTrace Grid Column Configuration"
  44.    Const ppItem = "SyncCode"
  45.    Const ppDefault = ""
  46.    Const Padder = "."
  47.  
  48. '--DECLARE STATIC VARIABLES
  49.    Static TraceOperationOffSwitch
  50.    Static PreviousLine()
  51.    Static PreviousTime() As Long
  52.    Static CumTime() As Long
  53.    Static PercentTime()
  54.    Static TotalRunTime As Long
  55.    Static EntryCount()
  56.    Static ExitCount()
  57.    Static LineNumber
  58.    Static ProcedureNames() As String
  59.    Static PreviousProcedure As String
  60.    Static PreviousOpCode
  61.    Static MarginWidth
  62.    Static VBTraceFileNo
  63.    
  64. '--IF TRACE HAS BEEN TURNED OFF THEN EXIT
  65.    If TraceOperationOffSwitch Then
  66.      Exit Sub
  67.    End If
  68.  
  69. '--GET ARBAY SIZE AND BUMP IF NECESSARY
  70.    ReDim EntryExit(1) As String
  71.    EntryExit(0) = "(Entry)"
  72.    EntryExit(1) = "(Exit)"
  73.    On Error Resume Next
  74.    For I = 0 To UBound(ProcedureNames)
  75.       If ProcedureName = ProcedureNames(I) Then
  76.          Exit For
  77.       End If
  78.    Next I
  79.    If I > UBound(ProcedureNames) Then
  80.       ReDim Preserve ProcedureNames(I + 100)
  81.       ReDim Preserve CumTime(I + 100)
  82.       ReDim Preserve PercentTime(I + 100)
  83.       ReDim Preserve EntryCount(I + 100)
  84.       ReDim Preserve ExitCount(I + 100)
  85.       ReDim Preserve PreviousLine(-1 To I + 100)
  86.       ReDim Preserve PreviousTime(-1 To I + 100)
  87.    End If
  88.    
  89. '--SET INDENT
  90.    Select Case OpCode
  91.       Case 1         'ENTERED PROCEDURE
  92.          EntryCount(I) = EntryCount(I) + 1
  93.          If PreviousOpCode = 1 Then
  94.             MarginWidth = MarginWidth + 2
  95.          End If
  96.       Case 2         'EXITED PROCEDURE
  97.          ExitCount(I) = ExitCount(I) + 1
  98.          If ProcedureName <> PreviousProcedure Or (ProcedureName = PreviousProcedure And PreviousOpCode = 2) Then
  99.             MarginWidth = MarginWidth - 2
  100.          End If
  101.    End Select
  102.          
  103. '--GET SYNCCODE IF FIRST LINE
  104.    ppValue = Space$(199)
  105.    Result = CMS_GetPrivateProfileString(ppTitle, ppItem, ppDefault, ppValue, Len(ppValue) + 1, app.Path & "\VBTRC96.INI")
  106.    SyncCode = Trim$(ppValue)
  107.    If SyncCode <> ThisProgramsSyncCode & Chr$(0) Then
  108.       Msg = "The VBTrace 96 Column Configuration Has Changed Since This Program "
  109.       Msg = Msg & "Was Loaded.  You Must Exit And Reload This Program."
  110.       MsgBox Msg, IconStop, "VBTrace Error Message"
  111.       Close
  112.       End
  113.    End If
  114.    On Error Resume Next
  115.    FL = FileLen(app.Path & "\VBTRC96.DAT")
  116.    FL = Err
  117.    On Error GoTo VBTraceError
  118.    If FL > 0 Or LineNumber = 0 Then
  119.       If FL = 0 Then
  120.          Kill app.Path & "\VBTRC96.DAT"
  121.       End If
  122.       OutRecord = "/*" & Now & ","
  123.       ReDim ProcedureNames(0)
  124.       I = False
  125.       LineNumber = False
  126.    End If
  127.    LineNumber = LineNumber + 1
  128.    
  129. '--GET ELASPSED TIME
  130.    ThisTime = CMS_TimeGetTime()
  131.    If PreviousTime(I) Then
  132.       If OpCode = 2 Then
  133.          ElapsedTime = Str$(ThisTime - PreviousTime(I))
  134.          CumTime(I) = CumTime(I) + Val(ElapsedTime)
  135.          CumlativeTime = Format$(CumTime(I))
  136.          TotalRunTime = TotalRunTime + Val(ElapsedTime)
  137.          TotalTime = Format$(TotalRunTime)
  138.          PercentTime(I) = CumTime(I) / TotalRunTime * 100
  139.          Percent = Format$(PercentTime(I))
  140.       End If
  141.    End If
  142.    ProcedureNames(I) = ProcedureName
  143.  
  144. '--ASSEMBLE COLUMN DATA
  145.    TraceGridVariable = "LineNumber"
  146.    OutRecord = OutRecord & "LineNumber," & LineNumber & ","
  147.    TraceGridVariable = "PreviousLine(I)"
  148.    OutRecord = OutRecord & "PreviousLine(I)," & PreviousLine(I) & ","
  149.    TraceGridVariable = "ElapsedTime"
  150.    OutRecord = OutRecord & "ElapsedTime," & ElapsedTime & ","
  151.    TraceGridVariable = "CumlativeTime"
  152.    OutRecord = OutRecord & "CumlativeTime," & CumlativeTime & ","
  153.    TraceGridVariable = "Percent"
  154.    OutRecord = OutRecord & "Percent," & Percent & ","
  155.    TraceGridVariable = "TotalTime"
  156.    OutRecord = OutRecord & "TotalTime," & TotalTime & ","
  157.    TraceGridVariable = "EntryCount(I)"
  158.    OutRecord = OutRecord & "EntryCount(I)," & EntryCount(I) & ","
  159.    TraceGridVariable = "ExitCount(I)"
  160.    OutRecord = OutRecord & "ExitCount(I)," & ExitCount(I) & ","
  161.    TraceGridVariable = "ProcedureName"
  162.    OutRecord = OutRecord & "ProcedureName," & ProcedureName & ","
  163.    OutRecord = OutRecord & "\,\,"
  164.    
  165. '--APPEND MEMORY VALUES TO RECORD
  166.    TraceGridVariable = "Available GDI Memory"
  167.    OutRecord = OutRecord & Format$(CMS_GetFreeSystemResources(CMS_GDI)) & ","
  168.    TraceGridVariable = "Available USER Memory"
  169.    OutRecord = OutRecord & Format$(CMS_GetFreeSystemResources(CMS_USR)) & ","
  170.    TraceGridVariable = "Available Global Heap Memory"
  171.    OutRecord = OutRecord & Format$(CMS_GetFreeSpace(0)) & ","
  172.       
  173. '--APPEND DISK SPACE TO RECORD
  174.    TraceGridVariable = "Available Disk Space"
  175.    OutRecord = OutRecord & Left$(app.Path, 1) & Format$(CMS_DiskSpaceFree()) & ","
  176.    
  177. '--APPEND FORMS COUNT TO RECORD
  178.    TraceGridVariable = "Forms Count"
  179.    OutRecord = OutRecord & Forms.Count & ","
  180.    
  181. '--APPEND PROCEDURE NAME TO RECORD
  182.    TraceGridVariable = ProcedureName
  183.    OutRecord = OutRecord & String$(MarginWidth, Padder) & ProcedureName & EntryExit(OpCode - 1)
  184.    TraceGridVariable = ""
  185.    
  186. '--APPEND PASSED VARIABLES TO RECORD
  187.  
  188. '--OPEN TRACE FILE, WRITE RECORD, AND CLOSE FILE
  189.    VBTraceFileNo = FreeFile
  190.    Open app.Path & "\VBTRC96.DAT" For Random Shared As VBTraceFileNo Len = TraceFileRecordLength
  191.       OutRecord = Left$(OutRecord & Space$(TraceFileRecordLength - 2), TraceFileRecordLength - 2)
  192.       Put #VBTraceFileNo, LineNumber, OutRecord
  193.       PreviousLine(I) = LineNumber
  194.       PreviousTime(I) = ThisTime
  195.       PreviousOpCode = OpCode
  196.       PreviousProcedure = ProcedureName
  197.   Close VBTraceFileNo
  198. Exit Sub
  199.    
  200. VBTraceError:
  201.    If Len(TraceGridVariable) Then
  202.       Msg = Error$ & " Referencing TraceGrid Variable '" & TraceGridVariable & "'.  "
  203.       Msg = Msg & "Disabling VBTrace 96."
  204.    End If
  205.    If Len(Msg) = 0 Then
  206.       Msg = Error$
  207.    End If
  208.    MsgBox Msg, IconStop, "VBTrace Error Handler"
  209.    Msg = ""
  210.    TraceOperationOffSwitch = True
  211.    Close VBTraceFileNo
  212.    If Len(Dir$(app.Path & "\VBTRC96.DAT")) Then
  213.       Close VBTraceFileNo
  214.       Kill app.Path & "\VBTRC96.DAT"
  215.    End If
  216.    Exit Sub
  217. End Sub
  218.  
  219.